implementation module japi
import StdEnv

:: *JapiState :== Int
:: Dev :== Int
:: D :== Device

:: Framer= Frm !Dev
:: Container=  Pan !Dev | Dia !Dev | Win !Dev
:: Bar= Mb !Dev 
:: Menu= Mn !Dev 
:: Entry=  Mi !Dev
:: Canvas= Cv !Dev |  Pr !Dev 
:: LDev= Li !Dev
:: Device=    Ke !Dev | S7 !Dev | Er !Dev 
            | Ac !Dev | Mo !Dev 
:: TDev=    Bn !Dev | Ll !Dev | Fd !Dev 
          | Ta !Dev | Mt !Dev | Bx !Dev

:: Scroll= Vs !Dev !Real !Real | Hs !Dev !Real !Real
       
jjs :: !Int -> *JapiState
jjs w=
   code {
     ccall japi_start "I-I"
    }

begin_japi :: !*World -> (!JapiState,!*World)
begin_japi world = (jjs 0,world)

end_japi :: !JapiState !*World -> *World
end_japi js world = world

sync_japi :: !JapiState !*World -> (!JapiState,!*World)
sync_japi js world = (js,world)



jcanvas :: !Int !Int !Int !JapiState -> (!Dev,!JapiState)
jcanvas fr w h js =
  code {
    ccall japi_canvas "III:I:I"
  }

jdrawline :: !Dev !Int !Int !Int !Int !JapiState-> (!Dev, !*JapiState)
jdrawline cv x1 y1 x2 y2 js=
  code {
     ccall japi_drawline "IIIII:I:I"
  }

jfillpolyg :: !Dev !{#Int} !{#Int} -> Dev
jfillpolyg cv x y =
   code {
     ccall japi_fillpolygon "IAA-I"
    }

    
jfilltriangle :: !(!Int, !Int) !(!Int, !Int) !(!Int, !Int)
                 !Canvas   -> Canvas
jfilltriangle (x1, y1) (x2, y2) (x3, y3)  cv
   # c= jfillpolyg (getCanvas cv) {x1,x2,x3} {y1, y2, y3}
   = updateCanvas cv c

jfillpolygon :: ![(Int, Int)] !Canvas   -> Canvas
jfillpolygon xs  cv
   # vx= {x \\ (x, y) <- xs}
   # vy= {y \\ (x, y) <- xs}
   # c= jfillpolyg (getCanvas cv) vx vy
   = updateCanvas cv c


jdrawpolylin :: !Dev !{#Int} !{#Int} -> Dev
jdrawpolylin cv x y =
   code {
     ccall japi_drawpolyline "IAA-I"
    }

jdrawpolyline :: ![(Int, Int)] !Canvas   -> Canvas
jdrawpolyline xs  cv
   # vx= {x \\ (x, y) <- xs}
   # vy= {y \\ (x, y) <- xs}
   # c= jdrawpolylin (getCanvas cv) vx vy
   = updateCanvas cv c



jdrawpolyg :: !Dev !{#Int} !{#Int} -> Dev
jdrawpolyg cv x y =
   code {
     ccall japi_drawpolygon "IAA-I"
    }



jdrawtriangle :: !(!Int, !Int) !(!Int, !Int) !(!Int, !Int)
                 !Canvas   -> Canvas
jdrawtriangle (x1, y1) (x2, y2) (x3, y3)  cv
   # c= jdrawpolyg (getCanvas cv) {x1,x2,x3} {y1, y2, y3}
   = updateCanvas cv c


jdrawpolygon :: ![(Int, Int)] !Canvas   -> Canvas
jdrawpolygon xs  cv
   # vx= {x \\ (x, y) <- xs}
   # vy= {y \\ (x, y) <- xs}
   # c= jdrawpolyg (getCanvas cv) vx vy
   = updateCanvas cv c
   

 
jtextarea :: !Int !Int !Int !JapiState -> (!Dev,!*JapiState)
jtextarea fr r c js=
   code {
               ccall japi_txtarea "III:I:I"
     }

jwin :: !Dev !JapiState -> (!Dev, !*JapiState)
jwin fr js=
   code {
      ccall japi_window "I:I:I"
    }
    
jnewWindow :: !Framer !JapiState -> (!Container, !*JapiState)
jnewWindow (Frm f) js
   # (w, js) = jwin f js
   = (Win w, js) 


jsettext :: !Dev !String -> Dev
jsettext i x=
  code {
           ccall japi_settext "IS-I"
   }

class SetText f
where
   jsetText :: !f !String -> f   

instance SetText TDev
where 
   jsetText :: !TDev !String -> TDev
   jsetText dv s 
     # dev= jsettext (getTDev dv) s
   = updateTDev dv dev

instance SetText Device
where 
   jsetText :: !Device !String -> Device
   jsetText dv s 
     # dev= jsettext (getDevice dv) s
   = updateDevice dv dev

class GetText f
where
   jgetText :: !f -> String
   
instance GetText TDev
where   
  jgetText :: !TDev -> String
  jgetText dv= jgettext (getTDev dv)

instance GetText Device
where   
  jgetText :: !Device -> String
  jgetText dv= jgettext (getDevice dv)
  
jgettext :: !Dev -> String
jgettext x=
   code {
              ccall japi_gettext "I-S"
    }



jsevensegment :: !Dev !Int !Int !JapiState -> (!Dev, !*JapiState)
jsevensegment dv iv color js=
  code {
     ccall japi_sevensegment "III:I:I"
     }     

jsetvalue :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsetvalue dv v js=
   code {
      ccall japi_setvalue "II:I:I"
    }

class Hasval f
where
   hasval :: !f -> Bool
   
instance Hasval Device
where
   hasval :: !Device -> Bool
   hasval (S7 d)= True
   hasval any= False

instance Hasval TDev where
   hasval :: !TDev -> Bool
   hasval (Mt d)= True
   hasval anyother= False


class SetVal f g
where
   jsetval :: !f !g !JapiState -> (!f, !*JapiState)

instance SetVal Scroll Real
where
   jsetval :: !Scroll !Real !JapiState -> (!Scroll, !*JapiState)
   jsetval (Vs dv m q) v js 
      # (d, js) = jsetvalue dv (toInt ((v-q)/m)) js
      = (Vs d m q, js)
   jsetval (Hs dv m q) v js 
      # (d, js) = jsetvalue dv (toInt ((v-q)/m)) js
      = (Hs d m q, js)
   jsetval dv v js  = (dv, js)
     
instance SetVal Device Int
where
   jsetval :: !Device !Int !JapiState -> (!Device, !*JapiState)
   jsetval dv v js | hasval dv
      # (d, js) = jsetvalue (getDevice dv) v js
      = (updateDevice dv d, js)
   jsetval dv v js  = (dv, js) 

instance SetVal TDev Int
where
   jsetval :: !TDev !Int !JapiState -> (!TDev, !*JapiState)
   jsetval dv v js | hasval dv
      # (d, js) = jsetvalue (getTDev dv) v js
      = (updateTDev dv d, js)
   jsetval dv v js  = (dv, js) 




jsetst :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsetst dv v js=
   code {
      ccall japi_setstate "II:I:I"
    }

jgetst :: !Dev !JapiState -> (!Dev, !*JapiState)
jgetst dv js=
   code {
      ccall japi_getstate "I:I:I"
    }

jgetstate :: !TDev  !JapiState -> (!Bool, !*JapiState)
jgetstate (Bx d) js
   # (n, js)= jgetst d js
   = (n==1, js)
jgetstate dv js= (False, js)

jsetstate :: !TDev !Int !JapiState -> (!TDev, !*JapiState)
jsetstate (Bx d) v js
   # (d, js) = jsetst d v js
   = (Bx d, js)
jsetstate dv v js= (dv, js)


getCanvas (Pr b) = b
getCanvas (Cv c)= c

updateCanvas (Cv _) c= Cv c
updateCanvas (Pr _) b= Pr b


getDevice (Ac a) = a
getDevice (Mo b) = b
getDevice (Ke b) = b
getDevice (S7 b) = b



updateDevice (Ac _) a= Ac a
updateDevice (Mo _) b= Mo b
updateDevice (Ke _) b= Ke b
updateDevice (S7 _) b= S7 b



getTDev (Bx x)= x
getTDev (Bn x)= x
getTDev (Ll x)= x
getTDev (Fd x)= x
getTDev (Ta x)= x
getTDev (Mt x)= x

updateTDev (Bx _) b= (Bx b)
updateTDev (Bn _) b= (Bn b)
updateTDev (Ll _) b= (Ll b)
updateTDev (Fd _) b= (Fd b)
updateTDev (Ta _) b= (Ta b)
updateTDev (Mt _) b= (Mt b)


getContainer (Pan x)= x
getContainer (Dia b) = b
getContainer (Win b) = b

updateContainer (Pan _) b= (Pan b)
updateContainer (Dia _) b= (Dia b)
updateContainer (Win _) b= (Win b)
      
class SetPos f
where
   jsetxy :: !f !Int !Int !JapiState -> (!f, !*JapiState)
   jsetwh :: !f !Int !Int !JapiState -> (!f, !*JapiState)
   setxy :: !f (!Int, !Int) !JapiState -> (!f, !*JapiState)
   
instance SetPos TDev
where
  jsetwh :: !TDev !Int !Int !JapiState -> (!TDev, !*JapiState)
  jsetwh dv w h js
      # (f, js) = jsetsz (getTDev dv) w h js
      = (updateTDev dv f, js)
  jsetxy :: !TDev !Int !Int !JapiState -> (!TDev, !*JapiState)
  jsetxy dv x y js
      # (f, js) = jsetp (getTDev dv) x y js
      = (updateTDev dv f, js)
  setxy :: !TDev (!Int, !Int) !JapiState -> (!TDev, !*JapiState)
  setxy dv (x, y) js= jsetxy dv x y js

instance SetPos Container
where
  jsetwh :: !Container !Int !Int !JapiState -> (!Container, !*JapiState)
  jsetwh dv w h js
      # (f, js) = jsetsz (getContainer dv) w h js
      = (updateContainer dv f, js)
  jsetxy :: !Container !Int !Int !JapiState -> (!Container, !*JapiState)
  jsetxy dv x y js
      # (f, js) = jsetp (getContainer dv) x y js
      = (updateContainer dv f, js)
  setxy :: !Container (!Int,!Int) !JapiState -> (!Container, !*JapiState)
  setxy dv (x,y) js= jsetxy dv x y js
  
instance SetPos Canvas
where
  jsetwh :: !Canvas !Int !Int !JapiState -> (!Canvas, !*JapiState)
  jsetwh (Cv dv) w h js
      # (f, js) = jsetsz dv w h js
      = (Cv f, js)
  jsetwh any w h js= (any, js)
  jsetxy :: !Canvas !Int !Int !JapiState -> (!Canvas, !*JapiState)
  jsetxy (Cv dv) x y js
      # (f, js) = jsetp dv x y js
      = (Cv f, js)
  jsetxy any x y js= (any, js)
  setxy :: !Canvas (!Int,!Int) !JapiState -> (!Canvas, !*JapiState)
  setxy cv (x,y) js= jsetxy cv x y js

instance SetPos Framer
where
  jsetwh :: !Framer !Int !Int !JapiState -> (!Framer, !*JapiState)
  jsetwh (Frm dv) w h js
      # (f, js) = jsetsz  dv w h js
      = (Frm f, js)
  jsetxy :: !Framer !Int !Int !JapiState -> (!Framer, !*JapiState)
  jsetxy (Frm dv) x y js
      # (f, js) = jsetp dv x y js
      = (Frm f, js)
  setxy :: !Framer (!Int,!Int) !JapiState -> (!Framer, !*JapiState)
  setxy fr (x, y) js= jsetxy fr x y js
  
instance SetPos LDev
where
  jsetwh :: !LDev !Int !Int !JapiState -> (!LDev, !*JapiState)
  jsetwh (Li dv) w h js
      # (f, js) = jsetsz  dv w h js
      = (Li f, js)
  jsetxy :: !LDev !Int !Int !JapiState -> (!LDev, !*JapiState)
  jsetxy (Li dv) x y js
      # (f, js) = jsetp dv x y js
      = (Li f, js)
  setxy :: !LDev (!Int,!Int) !JapiState -> (!LDev, !*JapiState)
  setxy dv (x,y) js= jsetxy dv x y js

instance SetPos Device 
where
  jsetwh :: !Device !Int !Int !JapiState -> (!Device, !*JapiState)
  jsetwh dv w h js= jsetsize dv w h js

  jsetxy :: !Device !Int !Int !JapiState -> (!Device, !*JapiState)
  jsetxy dv x y js= jsetpos dv x y js
  setxy :: !Device (!Int,!Int) !JapiState -> (!Device, !*JapiState)
  setxy dv (x,y) js= jsetxy dv x y js

instance SetPos Scroll
where
  jsetwh :: !Scroll !Int !Int !JapiState -> (!Scroll, !*JapiState)
  jsetwh (Vs dv h1 h2) w h js
      #(d, js)= jsetsz dv w h js
      = (Vs d h1 h2, js)
  jsetwh (Hs dv h1 h2) w h js
      #(d, js)= jsetsz dv w h js
      = (Vs d h1 h2, js)
  jsetxy :: !Scroll !Int !Int !JapiState -> (!Scroll, !*JapiState)
  jsetxy (Vs dv h1 h2) x y js 
      # (d, js)= jsetp dv x y js
      = (Vs d h1 h2, js)
  jsetxy (Hs dv h1 h2) x y js 
      # (d, js)= jsetp dv x y js
      = (Vs d h1 h2, js)
  setxy :: !Scroll (!Int,!Int) !JapiState -> (!Scroll, !*JapiState)
  setxy dv (x,y) js= jsetxy dv x y js
  

setcol :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
setcol dv c js=
   code {
      ccall japi_setcolumns "II:I:I"
    }
    
jsetcolumns :: !TDev !Int !JapiState -> (!TDev, !*JapiState)
jsetcolumns (Ta d) c js
   # (d, js)= setcol d c js
   = (Ta d, js)
jsetcolumns any c js= (any, js)
   
setro :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
setro dv c js=
   code {
      ccall japi_setrows "II:I:I"
    }
    
jsetrows :: !TDev !Int !JapiState -> (!TDev, !*JapiState)
jsetrows (Ta d) c js
   # (d, js)= setro d c js
   = (Ta d, js)
jsetrows any c js= (any, js)  
 
        

// Creating new things

class NewTDev f where
   jnewLabel :: !Pos !String !f   !*JapiState -> (!TDev, !*JapiState)          
   jnewTextArea::  !Pos !Int !Int !f  !*JapiState -> (!TDev, !*JapiState)
   jnewPanel ::  !Pos !f !*JapiState -> (!Container, !*JapiState)   
   jnewButton :: !Pos !String !f !JapiState -> (!TDev, !*JapiState)
   jnewCheckBox :: !Pos !String !f !JapiState -> (!TDev, !*JapiState)
   jnewField :: !Pos !Int !f !JapiState -> (!TDev, !*JapiState)
   

instance NewTDev Container where   
   jnewLabel :: !Pos !String !Container   !*JapiState -> (!TDev, !*JapiState)
   jnewLabel  (XY x y) s dv js 
      # (b, js)=  jlabel (getContainer dv) s js
        (lb, js)= jsetxy (Ll b) x y js
      = (lb,  js) 
   jnewLabel  (WH w h) s dv js 
      # (b, js)=  jlabel (getContainer dv) s js
        (lb, js)= jsetwh (Ll b) w h js
      = (lb,  js)
   jnewLabel  (XYWH x y w h) s dv js 
      # (b, js)=  jlabel (getContainer dv) s js
        (lb, js)= jsetxy (Ll b) w h js
        (lb, js)= jsetwh  lb x y js
      = (lb,  js) 
   jnewLabel  FLOW s dv js 
      # (b, js)=  jlabel (getContainer dv) s js
      = (Ll b,  js)

   jnewTextArea::  !Pos !Int !Int !Container  !*JapiState -> (!TDev, !*JapiState)
   jnewTextArea  (WH w h) r c dv js 
        # (txt, js)=  jtextarea (getContainer dv) r c js
          (txt, js)= jsetwh (Ta txt) w h js
        = (txt,  js) 
   jnewTextArea  (XY x y) r c dv js 
        # (txt, js)=  jtextarea (getContainer dv) r c js
          (txt, js)= jsetxy (Ta txt) x y js
        = (txt,  js) 
   jnewTextArea  (XYWH x y w h) r c dv js 
        # (txt, js)=  jtextarea (getContainer dv) r c js
          (txt, js)= jsetxy (Ta txt) x y js
          (txt, js)= jsetwh txt w h js
        = (txt,  js) 
   jnewTextArea  FLOW r c dv js 
        # (txt, js)=  jtextarea (getContainer dv) r c js
        = (Ta txt,  js) 

   jnewPanel ::  !Pos !Container !*JapiState -> (!Container, !*JapiState)
   jnewPanel FLOW frm  js 
      # (p, js)=  jpan (getContainer frm)  js
      = (Pan p,  js) 
   jnewPanel (WH w h) frm  js 
      # (p, js)=  jpan (getContainer frm)  js
        (pa, js)=  jsetwh (Pan p) w h js
      = (pa,  js) 
   jnewPanel (XY x y) frm  js 
      # (p, js)=  jpan (getContainer frm)  js
        (pa, js)=  jsetxy (Pan p) x y js
      = (pa,  js) 
   jnewPanel (XYWH x y w h) frm  js 
      # (p, js)=  jpan (getContainer frm)  js
        (pa, js)=  jsetxy (Pan p) x y js
        (pa, js)= jsetwh pa w h js
      = (pa,  js) 

   jnewButton :: !Pos !String !Container !JapiState -> (!TDev, !*JapiState)
   jnewButton (XY x y) nm dv js 
     # d= getContainer dv
       (b, js)= if (isgraphic nm)
                  (jgbutton d nm js)
                  (jbutton d nm js)
       (bt, js)= jsetxy (Bn b) x y js
     = (bt,  js) 
   jnewButton  (WH w h) nm dv js 
     # d= getContainer dv
       (b, js)= if (isgraphic nm)
                  (jgbutton d nm js)
                  (jbutton d nm js)
       (bt, js)= jsetwh (Bn b) w h js
     = (bt,  js)  
   jnewButton  (XYWH x y w h) nm dv js 
    # d= getContainer dv
      (b, js)= if (isgraphic nm)
                  (jgbutton d nm js)
                  (jbutton d nm js)
      (bt, js)= jsetwh (Bn b) w h js
      (bt, js)= jsetxy bt x y js
    = (bt, js)  
   jnewButton  FLOW nm dv js 
    # d= getContainer dv
      (b, js)= if (isgraphic nm)
                  (jgbutton d nm js)
                  (jbutton d nm js)
    = (Bn b,  js)      
   
   
   jnewCheckBox :: !Pos !String !Container !JapiState -> (!TDev, !*JapiState)
   jnewCheckBox (XY x y) nm dv js 
     # d= getContainer dv
       (b, js)=  jcheckbox d nm js
       (bt, js)= jsetxy (Bx b) x y js
     = (bt,  js) 
   jnewCheckBox (WH w h) nm dv js 
     # d= getContainer dv
       (b, js)= jcheckbox d nm js
       (bt, js)= jsetwh (Bx b) w h js
     = (bt,  js)  
   jnewCheckBox (XYWH x y w h) nm dv js 
    # d= getContainer dv
      (b, js)= jcheckbox d nm js
      (bt, js)= jsetwh (Bx b) w h js
      (bt, js)= jsetxy bt x y js
    = (bt, js)  
   jnewCheckBox FLOW nm dv js 
    # d= getContainer dv
      (b, js)= jcheckbox d nm js
    = (Bx b,  js)      
   
   
   jnewField :: !Pos !Int !Container !JapiState -> (!TDev, !*JapiState)
   jnewField  (XY x y) sz dv js 
       # (f, js)= jfield (getContainer dv) sz js
         (txt, js)= jsetxy (Fd f) x y js
       = (txt,  js) 
   jnewField  (WH w h) sz dv js 
       # (f, js)= jfield (getContainer dv) sz js
         (txt, js)= jsetwh (Fd f) w h js
       = (txt,  js)
   jnewField  (XYWH x y w h) sz dv js 
      # (f, js)= jfield (getContainer dv) sz js
        (txt, js)= jsetwh (Fd f) w h js
        (txt, js)= jsetxy txt x y js
      = (txt,  js) 
   jnewField  FLOW sz dv js 
       # (f, js)=  jfield (getContainer dv) sz js
       = (Fd f,  js)


instance NewTDev Framer where
   jnewLabel :: !Pos !String !Framer   !*JapiState -> (!TDev, !*JapiState)
   jnewLabel  (XY x y) s (Frm dv) js 
      # (b, js)=  jlabel dv s js
        (lb, js)= jsetxy (Ll b) x y js
      = (lb,  js) 
   jnewLabel  (WH w h) s (Frm dv) js 
      # (b, js)=  jlabel dv s js
        (lb, js)= jsetwh (Ll b) w h js
      = (lb,  js)
   jnewLabel  (XYWH x y w h) s (Frm dv) js 
      # (b, js)=  jlabel dv s js
        (lb, js)= jsetxy (Ll b) w h js
        (lb, js)= jsetwh  lb x y js
      = (lb,  js) 
   jnewLabel  FLOW s (Frm dv) js 
      # (b, js)=  jlabel  dv s js
      = (Ll b,  js)

   jnewTextArea::  !Pos !Int !Int !Framer  !*JapiState -> (!TDev, !*JapiState)
   jnewTextArea  (WH w h) r c (Frm dv) js 
        # (txt, js)=  jtextarea dv r c js
          (txt, js)= jsetwh (Ta txt) w h js
        = (txt,  js) 
   jnewTextArea  (XY x y) r c (Frm dv) js 
        # (txt, js)=  jtextarea dv r c js
          (txt, js)= jsetxy (Ta txt) x y js
        = (txt,  js) 
   jnewTextArea  (XYWH x y w h) r c (Frm dv) js 
        # (txt, js)=  jtextarea dv r c js
          (txt, js)= jsetwh (Ta txt) w h js
          (txt, js)= jsetxy txt x y js
        = (txt,  js) 
   jnewTextArea  FLOW r c (Frm dv) js 
        # (txt, js)=  jtextarea dv r c js
        = (Ta txt,  js) 
        
   jnewPanel ::  !Pos !Framer !*JapiState -> (!Container, !*JapiState)
   jnewPanel FLOW (Frm frm)  js 
      # (p, js)=  jpan frm  js
      = (Pan p,  js) 
   jnewPanel (WH w h) (Frm frm)  js 
      # (p, js)=  jpan frm  js
        (pa, js)=  jsetwh (Pan p) w h js
      = (pa,  js) 
   jnewPanel (XY x y) (Frm frm)  js 
      # (p, js)=  jpan frm  js
        (pa, js)=  jsetxy (Pan p) x y js
      = (pa,  js) 
   jnewPanel (XYWH x y w h) (Frm frm)  js 
      # (p, js)=  jpan frm  js
        (pa, js)=  jsetxy (Pan p) x y js
        (pa, js)= jsetwh pa w h js
      = (pa,  js) 

   jnewButton :: !Pos !String !Framer !JapiState -> (!TDev, !*JapiState)
   jnewButton (XY x y) nm (Frm d) js 
     # (b, js)= if (isgraphic nm)
                  (jgbutton d nm js)
                  (jbutton d nm js)
       (bt, js)= jsetxy (Bn b) x y js
     = (bt,  js) 
   jnewButton  (WH w h) nm (Frm d) js 
     # (b, js)= if (isgraphic nm)
                  (jgbutton d nm js)
                  (jbutton d nm js)
       (bt, js)= jsetwh (Bn b) w h js
     = (bt,  js)  
   jnewButton  (XYWH x y w h) nm (Frm d) js  
    # (b, js)= if (isgraphic nm)
                  (jgbutton d nm js)
                  (jbutton d nm js)
      (bt, js)= jsetwh (Bn b) w h js
      (bt, js)= jsetxy bt x y js
    = (bt, js)  
   jnewButton  FLOW nm (Frm d) js 
    # (b, js)= if (isgraphic nm)
                  (jgbutton d nm js)
                  (jbutton d nm js)
    = (Bn b,  js)      
   
   jnewCheckBox :: !Pos !String !Framer !JapiState -> (!TDev, !*JapiState)
   jnewCheckBox (XY x y) nm (Frm d) js 
     # (b, js)=  jcheckbox d nm js
       (bt, js)= jsetxy (Bx b) x y js
     = (bt,  js) 
   jnewCheckBox (WH w h) nm (Frm d) js 
     # (b, js)= jcheckbox d nm js
       (bt, js)= jsetwh (Bx b) w h js
     = (bt,  js)  
   jnewCheckBox (XYWH x y w h) nm (Frm d) js 
    # (b, js)= jcheckbox d nm js
      (bt, js)= jsetwh (Bx b) w h js
      (bt, js)= jsetxy bt x y js
    = (bt, js)  
   jnewCheckBox FLOW nm (Frm d) js 
    # (b, js)= jcheckbox d nm js
    = (Bx b,  js)   
   
   jnewField :: !Pos !Int !Framer !JapiState -> (!TDev, !*JapiState)
   jnewField  (XY x y) sz (Frm d) js 
       # (f, js)= jfield d sz js
         (txt, js)= jsetxy (Fd f) x y js
       = (txt,  js) 
   jnewField  (WH w h) sz (Frm d) js 
       # (f, js)= jfield d sz js
         (txt, js)= jsetwh (Fd f) w h js
       = (txt,  js)
   jnewField  (XYWH x y w h) sz (Frm d) js 
      # (f, js)= jfield d sz js
        (txt, js)= jsetwh (Fd f) w h js
        (txt, js)= jsetxy txt x y js
      = (txt,  js) 
   jnewField  FLOW sz (Frm d) js 
       # (f, js)=  jfield d sz js
       = (Fd f,  js)


      
jnewDialog ::  !Pos !String !Framer !*JapiState -> (!Container, !*JapiState)     
jnewDialog  (XYWH x y w h) s (Frm frm) js
     # (b, js)=  jdialog  frm s js
       (dl, js)= jsetxy (Dia b) x y js
       (dl, js)= jsetwh dl w h js
     = (dl,  js)
jnewDialog  (XY x y) nm (Frm frm) js
     # (b, js)= jdialog frm nm js
       (dl, js)= jsetxy (Dia b) x y js
     = (dl,  js)
jnewDialog  (WH w h) nm (Frm frm) js
     # (b, js)= jdialog frm nm js
       (dl, js)= jsetwh (Dia b) w h js
     = (dl,  js)
jnewDialog  FLOW nm (Frm frm) js
     # (b, js)= jdialog frm nm js
     = (Dia b,  js)  


jnewBar :: !Framer !*JapiState -> (!Bar, !*JapiState)
jnewBar (Frm f) js
  # (b, js)=  jmenubar f js
  = (Mb b,  js) 

jnewMenu :: !String !Bar !*JapiState -> (!Menu,  !*JapiState)
jnewMenu  s (Mb mb) js
   # (b, js)=  jmenu mb s js
   = (Mn b, js) 

jnewPopup :: !String !Framer !*JapiState -> (!Menu,  !*JapiState)
jnewPopup  s (Frm mb) js
   # (b, js)=  jpopupmenu mb s js
   = (Mn b, js) 
   

jnewItem :: !String !Menu !*JapiState -> (!Entry,  !*JapiState)
jnewItem  s (Mn m) js
   # (b, js)=  jmenuitem m s js
   = (Mi b,  js) 


jnewMeter :: !Pos !String !Container !*JapiState -> (!TDev, !*JapiState)
jnewMeter (XY x y) nm dv js 
   # (m, js)=  jmeter  (getContainer dv) nm  js
     (mtr, js)= jsetxy (Mt m) x y js
   = (mtr, js) 
jnewMeter  (WH w h) nm dv js
   # (m, js)=  jmeter  (getContainer dv) nm  js
     (mtr, js)= jsetwh (Mt m) w h js
   = (mtr, js)



class NewCanvas f where  
	jnewCanvas :: !Pos !f  !JapiState -> (!Canvas, !*JapiState)
	
instance NewCanvas Container where
	jnewCanvas :: !Pos !Container !JapiState -> (!Canvas, !*JapiState)
	jnewCanvas  (XYWH x y w h) dv js 
       # (c, js)=  jcanvas (getContainer dv) w h js
         (cv, js)= jsetxy (Cv c) x y js 
       = (cv, js) 
	jnewCanvas  (XY x y) dv js 
       # (c, js)=  jcanvas (getContainer dv) 100 100 js
         (cv, js)= jsetxy (Cv c) x y js 
       = (cv, js) 
	jnewCanvas  (WH w h) dv js 
       # (c, js)=  jcanvas (getContainer dv) w h js
       = (Cv c, js)
	jnewCanvas  FLOW dv js 
       # (c, js)=  jcanvas (getContainer dv) 100 100 js
       = (Cv c, js) 
       
instance NewCanvas Framer where
	jnewCanvas :: !Pos !Framer !JapiState -> (!Canvas, !*JapiState)
	jnewCanvas  (XYWH x y w h) (Frm dv) js 
       # (c, js)=  jcanvas dv w h js
         (cv, js)= jsetxy (Cv c) x y js
       = (cv, js) 
	jnewCanvas  (XY x y) (Frm dv) js 
       # (c, js)=  jcanvas dv 100 100 js
         (cv, js)= jsetxy (Cv c) x y js
       = (cv, js) 
	jnewCanvas  (WH w h) (Frm dv) js 
       # (c, js)=  jcanvas dv w h js
       = (Cv c, js) 
    jnewCanvas  FLOW (Frm dv) js 
       # (c, js)=  jcanvas dv 100 100 js
       = (Cv c, js) 
       




jshowppup :: !Dev !Int !Int !JapiState -> (!Dev, !*JapiState)
jshowppup p x y js=
    code {
       ccall japi_showpopup "III:I:I"
     }
     
jshowpopup ::  (!Int, !Int) !Menu !JapiState -> (!Menu, !*JapiState)
jshowpopup (x, y) (Mn mn) js
   # (m, js)= jshowppup mn x y js
   = (Mn m, js)
   

jpopupmenu :: !Dev !String !JapiState -> (!Dev, !*JapiState)
jpopupmenu fr s js=
    code {
       ccall japi_popupmenu "IS:I:I"
     }


jhscrollbar :: !Dev !Int !Int !Int !JapiState -> (!Dev, !*JapiState)
jhscrollbar dv slideSize mn mx js=
    code {
       ccall japi_hscrollbar "IIII:I:I"
     }   

jvscrollbar :: !Dev !Int !Int !Int !JapiState -> (!Dev, !*JapiState)
jvscrollbar dv slideSize mn mx js=
    code {
       ccall japi_vscrollbar "IIII:I:I"
     }  
     

jgetvalue :: !Dev  -> Int
jgetvalue dv=
   code {
      ccall japi_getvalue "I-I"
    }
    


jslideval :: !Scroll -> (!Real, !Scroll)
jslideval (Vs dv m q)
   # v= jgetvalue  dv
   = (m*(toReal v)+q, Vs dv m q)
jslideval (Hs dv m q)
   # v= jgetvalue  dv
   = (m*(toReal v)+q, Hs dv m q)
jslideval dv = (0.0, dv)

slideSz :== 2


class DeviceSeting f where
    jnew7seg:: !Pos !Int !Int !f !JapiState -> (!Device, !*JapiState)
    jnewHScrollBar:: !Pos !Real !Real
                !f !JapiState -> (!Scroll, !*JapiState)
    jnewVScrollBar:: !Pos !Real !Real
                !f !JapiState -> (!Scroll, !*JapiState)

instance DeviceSeting Framer where
   jnew7seg:: !Pos !Int !Int !Framer !JapiState -> (!Device, !*JapiState)
   jnew7seg  (XY x y) iv color (Frm dv) js 
      # (b, js)= jsevensegment  dv iv color  js
        (sevenseg, js)= jsetxy (S7 b) x y js
        (sevenseg, js) = jsetsize sevenseg 20 30 js 
      = (sevenseg, js) 
   jnew7seg  (WH w h) iv color (Frm dv) js 
      # (b, js)=  jsevensegment  dv iv color  js
        (sevenseg, js) = jsetwh (S7 b) w h js 
      = (sevenseg, js)
   jnew7seg  (XYWH x y w h) iv color  (Frm dv) js 
      # (b, js)=  jsevensegment  dv iv color  js
        (sevenseg, js) = jsetwh (S7 b) w h js 
        (sevenseg, js) = jsetxy sevenseg x y js
      = (sevenseg, js)
   jnew7seg  FLOW iv color  (Frm dv) js 
      # (b, js)=  jsevensegment  dv iv color  js
        (sevenseg, js) = jsetwh (S7 b) 20 30 js 
      = (sevenseg, js)
   
   jnewHScrollBar:: !Pos !Real !Real
             !Framer !JapiState -> (!Scroll, !*JapiState)
   jnewHScrollBar  (XY x y) h1 h2  (Frm dv) js 
    # (b, js)=  jhscrollbar dv slideSz 0 100 js
      (sb, js)= jsetxy (Hs b ((h2-h1)/100.0) h1) x y js
      (sb, js) = jsetwh sb 100 30 js 
    = (sb, js) 
   jnewHScrollBar  (WH w h)  h1 h2 (Frm dv) js 
      # (b, js)=  jhscrollbar  dv slideSz  0 100  js
        (sb, js) = jsetwh (Hs b  ((h2-h1)/100.0) h1) w h js 
      = (sb, js)
   jnewHScrollBar  (XYWH x y w h) h1 h2   (Frm dv) js 
      # (b, js)=  jhscrollbar  dv slideSz 0 100  js
        (sb, js) = jsetwh (Hs b  ((h2-h1)/100.0) h1) w h js 
        (sb, js) = jsetxy sb x y js
      = (sb, js)
   jnewHScrollBar  FLOW h1 h2  (Frm dv) js 
      # (b, js)=  jhscrollbar  dv slideSz 0 100 js
        (sb, js) = jsetwh (Hs b  ((h2-h1)/100.0) h1) 100 30 js 
      = (sb, js) 
   jnewVScrollBar:: !Pos !Real !Real
             !Framer !JapiState -> (!Scroll, !*JapiState)
   jnewVScrollBar  (XY x y) h1 h2  (Frm dv) js 
      # (b, js)=  jvscrollbar dv slideSz 0 100 js
        (sb, js)= jsetxy (Vs b ((h1-h2)/100.0) h2) x y js
        (sb, js) = jsetwh sb 100 30 js 
      = (sb, js) 
   jnewVScrollBar  (WH w h)  h1 h2 (Frm dv) js 
      # (b, js)=  jvscrollbar  dv slideSz  0 100  js
        (sb, js) = jsetwh (Vs b  ((h1-h2)/100.0) h2) w h js 
      = (sb, js)
   jnewVScrollBar  (XYWH x y w h) h1 h2   (Frm dv) js 
      # (b, js)=  jvscrollbar  dv slideSz 0 100  js
        (sb, js) = jsetwh (Vs b  ((h1-h2)/100.0) h2) w h js 
        (sb, js) = jsetxy sb x y js
      = (sb, js)
   jnewVScrollBar  FLOW h1 h2  (Frm dv) js 
      # (b, js)=  jvscrollbar  dv slideSz 0 100 js
        (sb, js) = jsetwh (Vs b  ((h1-h2)/100.0) h2) 100 30 js 
      = (sb, js) 
      

instance DeviceSeting Container where
   jnew7seg:: !Pos !Int !Int !Container !JapiState -> (!Device, !*JapiState)
   jnew7seg  (XY x y) iv color dv js 
      # (b, js)=  jsevensegment  (getContainer dv) iv color  js
        (sevenseg, js)= jsetxy (S7 b) x y js
        (sevenseg, js) = jsetsize sevenseg 20 30 js 
      = (sevenseg, js) 
   jnew7seg  (WH w h) iv color dv js 
      # (b, js)=  jsevensegment  (getContainer dv) iv color  js
        (sevenseg, js) = jsetwh (S7 b) w h js 
      = (sevenseg, js)
   jnew7seg  (XYWH x y w h) iv color   dv js 
      # (b, js)=  jsevensegment  (getContainer dv) iv color  js
        (sevenseg, js) = jsetwh (S7 b) w h js 
        (sevenseg, js) = jsetxy sevenseg x y js
      = (sevenseg, js)
   jnew7seg  FLOW iv color  dv js 
      # (b, js)=  jsevensegment  (getContainer dv) iv color  js
        (sevenseg, js) = jsetwh (S7 b) 20 30 js 
      = (sevenseg, js)
   
   jnewHScrollBar:: !Pos !Real !Real
             !Container !JapiState -> (!Scroll, !*JapiState)
   jnewHScrollBar  (XY x y) h1 h2 dv js 
    # (b, js)=  jhscrollbar (getContainer dv) slideSz 0 100 js
      (sb, js)= jsetxy (Hs b ((h2-h1)/100.0) h1) x y js
      (sb, js) = jsetwh sb 100 30 js 
    = (sb, js) 
   jnewHScrollBar  (WH w h)  h1 h2 dv js 
      # (b, js)=  jhscrollbar  (getContainer dv) slideSz  0 100  js
        (sb, js) = jsetwh (Hs b  ((h2-h1)/100.0) h1) w h js 
      = (sb, js)
   jnewHScrollBar  (XYWH x y w h) h1 h2   dv js 
      # (b, js)=  jhscrollbar  (getContainer dv) slideSz 0 100  js
        (sb, js) = jsetwh (Hs b  ((h2-h1)/100.0) h1) w h js 
        (sb, js) = jsetxy sb x y js
      = (sb, js)
   jnewHScrollBar  FLOW h1 h2  dv js 
      # (b, js)=  jhscrollbar  (getContainer dv) slideSz 0 100 js
        (sb, js) = jsetwh (Hs b  ((h2-h1)/100.0) h1) 100 30 js 
      = (sb, js) 
   jnewVScrollBar:: !Pos !Real !Real
             !Container !JapiState -> (!Scroll, !*JapiState)
   jnewVScrollBar  (XY x y) h1 h2  dv js 
      # (b, js)=  jvscrollbar (getContainer dv) slideSz 0 100 js
        (sb, js)= jsetxy (Vs b ((h1-h2)/100.0) h2) x y js
        (sb, js) = jsetwh sb 100 30 js 
      = (sb, js) 
   jnewVScrollBar  (WH w h)  h1 h2 dv js 
      # (b, js)=  jvscrollbar  (getContainer dv) slideSz  0 100  js
        (sb, js) = jsetwh (Vs b  ((h1-h2)/100.0) h2) w h js 
      = (sb, js)
   jnewVScrollBar  (XYWH x y w h) h1 h2   dv js 
      # (b, js)=  jvscrollbar  (getContainer dv) slideSz 0 100  js
        (sb, js) = jsetwh (Vs b  ((h1-h2)/100.0) h2) w h js 
        (sb, js) = jsetxy sb x y js
      = (sb, js)
   jnewVScrollBar  FLOW h1 h2  dv js 
      # (b, js)=  jvscrollbar  (getContainer dv) slideSz 0 100 js
        (sb, js) = jsetwh (Vs b  ((h1-h2)/100.0) h2) 100 30 js 
      = (sb, js) 
      


isgraphic s = loop 0
where
  nd= (size s) - 1
  graphicExtension x= x== ".gif" || x== ".jpg"
  loop j
    | j >= (size s) = False
    | j < 0= False
    | s.[j] == '.' = graphicExtension (s%(j, nd))
    | otherwise= loop (j+1)

jmousepressed :: !Canvas -> (!Device, !Canvas)
jmousepressed (Cv cv)
  # (c, m) = mousepressed cv
  = (Mo m, Cv c)
jmousepressed d= (Er 2, d)

jmousereleased :: !Canvas -> (!Device, !Canvas)
jmousereleased (Cv cv)
  # (c, m) = mousereleased cv
  = (Mo m, Cv c)
jmousereleased d= (Er 2, d)


jkeylistener :: !Dev -> Dev
jkeylistener canvas=
   code {
         ccall japi_keylistener "I-I"
    }

keypressed :: !Dev -> (!Dev, Dev)
keypressed cv= (cv, jkeylistener cv)   
 
keycode :: !Dev -> *Int
keycode x=
    code {
           ccall japi_getkeycode "I-I"
      }

class Keyboard f where
   jkeyboard :: !f -> (!Device, !f)
   
instance Keyboard Canvas where
   jkeyboard :: !Canvas -> (!Device, !Canvas)
   jkeyboard dv
      # (c, m) = keypressed (getCanvas dv)
      = ( Ke m, updateCanvas dv c)

instance Keyboard Framer where
   jkeyboard :: !Framer -> (!Device, !Framer)
   jkeyboard (Frm dv)
      # (c, m) = keypressed dv
      = ( Ke m, Frm c)
      
jkeycode :: !Device -> *Int
jkeycode (Ke k) = keycode k
jkeycode dv = 0


jframe :: !String  !JapiState -> (!Dev,!JapiState)
jframe x  js =
   code {
        ccall japi_frame "S:I:I"
   }

cshow :: !Int !JapiState -> (!Int,!JapiState)
cshow x js =
   code {
              ccall japi_show "I:I:I"
   }


class Show f where
   jshow :: !f !JapiState -> (!f,!JapiState)   

instance Show Container where
   jshow :: !Container !JapiState -> (!Container,!JapiState)
   jshow (Dia fr) js
      # (fr, js) = showDialog fr js
   = (Dia fr, js)
   jshow (Win fr) js
      # (fr, js) = showDialog fr js
      = (Win fr, js)
   jshow any js= (any, js)

instance Show Framer where
   jshow :: !Framer !JapiState -> (!Framer,!JapiState)
   jshow (Frm fr) js
     # (fr, js) = cshow fr js
     = (Frm fr, js)
 
   
fr_enable :: !Int !JapiState -> (!Int,!JapiState)
fr_enable x js =
   code {
              ccall japi_enable "I:I:I"
   }
   
fr_disable :: !Int !JapiState -> (!Int,!JapiState)
fr_disable x js =
   code {
              ccall japi_disable "I:I:I"
   }
   
jEnable :: !Framer !JapiState -> (!Framer, !JapiState)
jEnable (Frm dv) js
   # (dv, js)= fr_enable dv js
   = (Frm dv, js)
   
jDisable :: !Framer !JapiState -> (!Framer, !JapiState)
jDisable (Frm dv) js
   # (d, js)= fr_disable  dv js
   = (Frm dv, js)
     

showDialog :: !Dev !JapiState -> (!Dev,!JapiState)
showDialog x js =
   code {
              ccall japi_show "I:I:I"
   }

hideDialog :: !Dev !JapiState -> (!Dev,!JapiState)
hideDialog x js =
   code {
              ccall japi_hide "I:I:I"
   }

showDlg :: !Dev -> Dev
showDlg d=
   code {
              ccall japi_show "I-I"
   }

show :: !Container -> Container
show dlg = updateContainer dlg (showDlg (getContainer dlg))

hideDlg :: !Dev -> Dev
hideDlg d=
   code {
              ccall japi_hide "I-I"
   }

hide :: !Container -> Container
hide dlg = updateContainer dlg (hideDlg (getContainer dlg))

jhide :: !Container !JapiState -> (!Container,!JapiState)   
jhide (Dia d) js
   # (d, js)= hideDialog d js
   = (Dia d, js)
jhide (Win d) js
   # (d, js)= hideDialog d js
   = (Win d, js)
jhide dv js= (dv, js)

jcheckbox :: !Dev  !String !JapiState -> (!Dev,!*JapiState)
jcheckbox fr nm js=
   code {
         ccall japi_checkbox "IS:I:I"
   }


jbutton :: !Dev  !String !JapiState -> (!Dev,!*JapiState)
jbutton fr nm js=
   code {
         ccall japi_button "IS:I:I"
   }

jgbutton :: !Dev  !String !JapiState -> (!Dev,!*JapiState)
jgbutton fr nm js=
   code {
         ccall japi_graphicbutton "IS:I:I"
   }

dialogButton :: !Dev !Int !Int !Int !Int !String !JapiState -> (!Dev,!*JapiState)
dialogButton dlg x y w h nm js=
   code {
         ccall japi_button "IIIIIS:I:I"
   }

udialogButton :: !Dev !String !JapiState -> (!Dev,!*JapiState)
udialogButton dlg nm js=
   code {
         ccall japi_button "IS:I:I"
   }

   

jlabel :: !Dev !String !JapiState -> (!Dev,!*JapiState)
jlabel fr nm js=
   code {
         ccall japi_label "IS:I:I"
   }

j_quit :: !Int !JapiState -> (!Int,!JapiState)
j_quit x js =
   code {
              ccall japi_quit "I:I:I"
    }
    
jquit :: !JapiState -> JapiState
jquit js
  # (_, js)= j_quit 0 js
  = js
     
jnextac :: !Int !JapiState -> (!Int, !*JapiState)
jnextac x js=
   code {
          ccall japi_nextaction "I:I:I"
    }

jnextaction ::  !JapiState -> (!Int, !*JapiState)
jnextaction js= jnextac 0 js

jgetaction :: !Int !JapiState -> (!Int,!*JapiState)
jgetaction x js =
   code {
              ccall japi_getaction "I:I:I"
    }
    

class Action g
where
   act :: !g -> Int

instance Action LDev
where
   act :: !LDev  -> Int
   act (Li dv)=  dv

instance Action Scroll
where
   act :: !Scroll  -> Int
   act (Vs d m q)=  d
   act (Hs d m q)=  d

instance Action Device
where
   act :: !Device  -> Int
   act dv=  (getDevice dv)

instance Action Container
where
   act :: !Container  -> Int
   act (Pan txt)=  txt
   act (Dia txt)= txt
 
instance Action Framer
where
   act :: !Framer  -> Int
   act (Frm txt)=  txt
   

instance Action Entry
where
   act :: !Entry  -> Int
   act (Mi txt)=  txt
   
instance Action TDev
where
   act :: !TDev  -> Int
   act dv=  (getTDev dv)
      
     
jfield :: !Dev  !Int !JapiState -> (!Dev,!*JapiState)
jfield frm  sz js=
  code {
       ccall japi_textfield "II:I:I"
  }

jflowfield :: !Dev !Int !Int  !JapiState -> (!Dev,!*JapiState)
jflowfield frm w h  js=
  code {
       ccall japi_flowfield "III:I:I"
  }
  
dialogField :: !Dev !Int !Int !Int !Int !Int !JapiState -> (!Dev,!*JapiState)
dialogField frm x y w h sz js=
  code {
       ccall japi_textfield "IIIIII:I:I"
  }

dialogText :: !Dev !Int !Int !Int !JapiState -> (!Dev,!*JapiState)
dialogText frm x y sz js= dialogField  frm x y (sz*10) 25 sz js
  

jsync :: !JapiState -> *JapiState
jsync x=
    code {
           ccall japi_sync "I-I"
     }
    
jsleep :: !Int !JapiState -> (!Int,!JapiState)
jsleep x s =
   code {
        ccall japi_sleep "I:I:I"
    }
   

jcolor :: !Dev !Int !Int !Int -> Dev
jcolor cv x y z=
    code {
            ccall japi_setcolor "IIII-I"
     }

jsetxortrue :: !Dev  -> Dev
jsetxortrue cv=
    code {
            ccall japi_setxortrue "I-I"
     }
     
jsetxorfalse :: !Dev  -> Dev
jsetxorfalse cv=
    code {
            ccall japi_setxorfalse "I-I"
     }
     
jsetxor :: !Bool !Canvas  -> Canvas
jsetxor b dv
  # c= getCanvas dv
  # cv = if b (jsetxortrue c) (jsetxorfalse c)
  = updateCanvas dv cv
  


jsetcolorbg :: !Dev !Int !Int !Int -> Dev
jsetcolorbg cv x y z=
    code {
            ccall japi_setcolorbg "IIII-I"
     }

jsetnamedcolorbg :: !Dev !Int !JapiState -> (!Dev, !*JapiState) 
jsetnamedcolorbg cv c js=
    code {
            ccall japi_setbgcolor "II:I:I"
     }




class SetColor f where
   bg_color ::  !(!Int, !Int, !Int) !f -> f
   color ::  !(!Int, !Int, !Int) !f -> f
   bg_namedcolor :: !Int !(!f, !JapiState)  -> (!f, !*JapiState)
      
instance SetColor TDev where
	bg_color ::  !(!Int, !Int, !Int) !TDev -> TDev
	bg_color  (x, y, z) cv= updateTDev cv (jsetcolorbg (getTDev cv) x y z)
    bg_namedcolor ::  !Int !(!TDev, !JapiState) -> (!TDev, !*JapiState)
    bg_namedcolor r (cv, js)
         # (c, js)= jsetnamedcolorbg (getTDev cv) r js
         = (updateTDev cv c, js)
    color :: !(!Int, !Int, !Int)  !TDev -> TDev
	color (x, y, z) cv= updateTDev cv (jcolor (getTDev cv) x y z)
	
instance SetColor Framer where
	bg_color ::  !(!Int, !Int, !Int) !Framer-> Framer
	bg_color (x, y, z) (Frm f) 
	     # f= jsetcolorbg f x y z
	     = (Frm f)
	bg_namedcolor ::  !Int (!Framer, !JapiState) -> (!Framer, !*JapiState)
    bg_namedcolor  r (Frm cv,js)
         # (c, js)= jsetnamedcolorbg cv r js
         = (Frm c, js)
    color ::  !(!Int, !Int, !Int) !Framer-> Framer
	color (x, y, z) (Frm f) 
	     # f= jcolor f x y z
	     = (Frm f)
	
instance SetColor Container where
	bg_color ::  !(!Int, !Int, !Int) !Container-> Container
	bg_color (x, y, z) fr 
	     # f= jsetcolorbg (getContainer fr) x y z
	     = (updateContainer fr f)
	bg_namedcolor ::  !Int (!Container, !JapiState) -> (!Container, !*JapiState)
    bg_namedcolor  r (cv, js)
         # (c, js)= jsetnamedcolorbg (getContainer cv) r js
         = (updateContainer cv c, js)
	color ::  !(!Int, !Int, !Int) !Container-> Container
	color  (x, y, z) fr
	     # f= jcolor (getContainer fr) x y z
	     = (updateContainer fr f)
	     
instance SetColor Canvas where
	bg_color ::  !(!Int, !Int, !Int) !Canvas -> Canvas
	bg_color  (x, y, z) fr
	     # f= jsetcolorbg (getCanvas fr) x y z
	     = (updateCanvas fr f)
	bg_namedcolor ::  !Int (!Canvas, !JapiState) -> (!Canvas, !*JapiState)
    bg_namedcolor  r (cv, js)
         # (c, js)= jsetnamedcolorbg (getCanvas cv) r js
         = (updateCanvas cv c, js)
	color ::  !(!Int, !Int, !Int) !Canvas -> Canvas
	color (x, y, z)  fr
	     # f= jcolor (getCanvas fr) x y z
	     = (updateCanvas fr f)
instance SetColor RC where
	bg_color ::  !(!Int, !Int, !Int) !RC -> RC
	bg_color  (x, y, z) (Scale fr w h p q)
	     # f= jsetcolorbg (getCanvas fr) x y z
	     = Scale (updateCanvas fr f) w h p q
	bg_namedcolor ::  !Int (!RC, !JapiState) -> (!RC, !*JapiState)
    bg_namedcolor  r (Scale cv w h p q, js)
         # (c, js)= jsetnamedcolorbg (getCanvas cv) r js
         = (Scale (updateCanvas cv c) w h p q, js)
	color ::  !(!Int, !Int, !Int) !RC -> RC
	color (x, y, z)  (Scale fr w h p q)
	     # f= jcolor (getCanvas fr) x y z
	     = Scale (updateCanvas fr f) w h p q

	     
jfillcircle :: !Dev !Int !Int !Int !JapiState-> (!Dev, !JapiState)
jfillcircle cv x y z js=
    code {
           ccall japi_fillcircle "IIII:I:I"
     }

jdisk :: !Dev (!Int, !Int) !Int !JapiState-> (!Dev, !JapiState)
jdisk cv (x, y) z js= jfillcircle cv x y z js


red :: (Int, Int, Int)
red = (255, 0, 0)

blue :: (Int, Int, Int)
blue = (0, 0, 255)

green :: (Int, Int, Int)
green = (0, 255, 0)

yellow :: (Int, Int, Int)
yellow = (255, 255, 0)

white :: (Int, Int, Int)
white = (255, 255, 255)

black :: (Int, Int, Int)
black= (0, 0, 0)

jloadimage :: !String !JapiState -> (!Int,!JapiState)
jloadimage s js =
    code {
            ccall japi_loadimage "S:I:I"
     }


jdraw :: !Drawable !Canvas -> Canvas
jdraw  (Cir(x, y) r) dv
   # (cv, _) = circle (getCanvas dv) x y r 0
   = updateCanvas dv cv
jdraw  (Img(x,y) i) dv
   # (c, _) = jdrawimage (getCanvas dv) i x y 0
   = updateCanvas dv c
jdraw  (Txt (x, y) s) dv
   # (c, _) = drawstr (getCanvas dv) x y s 0
   = updateCanvas dv c
jdraw  (Rct(x, y) w h) dv
   # (cv, _) = rect (getCanvas dv) x y w h 0
   = updateCanvas dv cv
jdraw  (Lin(x1, y1) (x2, y2)) dv
   # (cv, _) = jdrawline (getCanvas dv) x1 y1 x2 y2 0
   = (updateCanvas dv  cv)
jdraw  (Arr(x1, y1) (x2, y2)) dv
   # cv = make_arrow  (x1, y1) (x2, y2) (getCanvas dv)
   = (updateCanvas dv  cv)
jdraw  (Arc(x1,y1) w h st nd) dv
   # (cv, js)= drawarc (getCanvas dv) x1 y1 w h st nd 0
   = (updateCanvas dv  cv)
jdraw  (Ovl(x1,y1) w h) dv
   # (cv, js)= oval (getCanvas dv) x1 y1 w h 0
   = (updateCanvas dv  cv)
jdraw  (Rrc(x1,y1) w h st nd) dv
   # (cv, js)= drawroundrect (getCanvas dv) x1 y1 w h st nd 0
   = (updateCanvas dv  cv)
jdraw (Tri p1 p2 p3) dv= jdrawtriangle p1 p2 p3 dv
jdraw (Plg xs) dv= jdrawpolygon xs dv
jdraw (Pll xs) dv= jdrawpolyline xs dv
jdraw (Hue c) dv= color c dv
jdraw (Fnt f) dv= jsetfont f dv
jdraw (Xor b) dv= jsetxor b dv
jdraw dr d= d

jdrawc :: !(!Int, !Int, !Int)  !Drawable !Canvas -> Canvas
jdrawc c fig cv
   #  cv= color c cv
   # cv= jdraw fig cv
   = color black cv


jfill :: !Drawable !Canvas -> Canvas
jfill  (Img(x,y) i) dv
   # (c, js) = jdrawimage (getCanvas dv) i x y  0
   = (updateCanvas dv c)
jfill  (Txt (x, y) s) dv
   # (c, js) = drawstr (getCanvas dv) x y s 0
   = (updateCanvas dv c)
jfill  (Rct(x, y) w h) dv
   # (cv, js)= fillrect (getCanvas dv) x y w h 0
   = (updateCanvas dv  cv)
jfill  (Cir(x, y) r) dv
   # (cv, js) = jfillcircle (getCanvas dv) x y r 0    
   = (updateCanvas dv  cv)
jfill  (Lin(x1, y1) (x2, y2)) dv
   # (cv, js) = jdrawline (getCanvas dv) x1 y1 x2 y2 0
   = (updateCanvas dv  cv)
jfill (Arr(x1, y1) (x2, y2)) dv
  # cv = make_arrow  (x1, y1) (x2, y2) (getCanvas dv)
  = (updateCanvas dv cv)
jfill  (Arc(x1,y1) w h st nd) dv
  # (cv, js) = fillarc (getCanvas dv) x1 y1 w h st nd 0  
   = (updateCanvas dv  cv)
jfill  (Ovl(x1,y1) w h) dv
   # (cv, js)= filloval (getCanvas dv) x1 y1 w h 0
   = (updateCanvas dv  cv)
jfill  (Rrc(x1,y1) w h st nd) dv
    # (cv, js) = fillroundrect (getCanvas dv) x1 y1 w h st nd 0
    = (updateCanvas dv cv)
jfill (Tri p1 p2 p3) dv= jfilltriangle p1 p2 p3 dv
jfill (Plg xs) dv= jfillpolygon xs dv
jfill (Pll xs) dv= jdrawpolyline xs dv
jfill (Hue c) dv= color c dv
jfill (Fnt f) dv= jsetfont f dv
jfill (Xor b) dv= jsetxor b dv
jfill dr d= d

jfillc :: !(!Int, !Int, !Int)  !Drawable !Canvas -> Canvas
jfillc c fig cv
   #  cv= color  c cv
   # cv= jfill fig  cv
   = color  black cv
   

jdrawimage :: !Dev !Int !Int !Int !JapiState -> (!Dev,!JapiState)
jdrawimage cv img x y js =
    code {
              ccall japi_drawimage "IIII:I:I"
     }

jgetimg :: !Dev  -> Int
jgetimg cv=
   code {
     ccall japi_getimage "I-I"
   }

jcutimg :: !Dev !Int !Int !Int !Int !Int !Int  -> Int
jcutimg cv x0 y0 x1 y1 w h=
   code {
     ccall japi_getscaledimage "IIIIIII-I"
   }



class CutImage f g where
   jcutimage :: !f !(!g, !g) !g !g -> Int
   
instance CutImage Canvas Int where
   jcutimage :: !Canvas !(!Int,  !Int) !Int !Int -> Int
   jcutimage cv (x, y) w h= jcutimg (getCanvas cv) x y w h w h
   
instance CutImage RC Real where
   jcutimage :: !RC !(!Real, !Real) !Real !Real -> Int
   jcutimage (Scale cv w h (rx0, ry0) (rw, rh)) (xc, yc) mw mh
       # xm= rw/w
       # ym= ~rh/h
       # (x, y)= (xm*(toReal xc)-rx0, ym*(toReal yc) +rh-ry0)
       # nw= toInt(mw* rw/ w)
       # nh= toInt(mh * rh/h)
       # (x, y)= (toInt(xm*(toReal xc)-rx0), toInt(ym*(toReal yc) +rh-ry0))
       =jcutimg (getCanvas cv) x y nw nh nw nh
          
   
class GetImage f where
   jgetimage :: !f -> Int
   
instance GetImage Canvas where
   jgetimage :: !Canvas -> Int
   jgetimage cv = jgetimg (getCanvas cv)
    
instance GetImage RC  where
   jgetimage :: !RC -> Int
   jgetimage (Scale cv w h p q)=jgetimg (getCanvas cv) 

  
jsavebmp :: !Int !String !JapiState -> (!Int, !JapiState)
jsavebmp cv file js=
   code {
      ccall japi_savebmp "IS:I:I"
    }

jsavejpg :: !Int !String !JapiState -> (!Int, !JapiState)
jsavejpg cv file js=
   code {
      ccall japi_savejpg "IS:I:I"
    }

jsaveppm :: !Int !String !JapiState -> (!Int, !JapiState)
jsaveppm cv file js=
   code {
      ccall japi_saveppm "IS:I:I"
    }

jsavegif :: !Int !String !JapiState -> (!Int, !JapiState)
jsavegif cv file js=
   code {
      ccall japi_savegif "IS:I:I"
    }
    

mouselistener :: !Int !Int -> Int
mouselistener cv s=
   code {
            ccall japi_mouselistener "II-I"
     }
    
mousepressed :: !Dev -> (!Dev, !Dev)
mousepressed cv= (cv, mouselistener cv 2)

mousereleased :: !Dev -> (!Dev, !Dev)
mousereleased cv= (cv, mouselistener cv 3)

mxy :: !Device -> (Int, Int)
mxy (Mo m)= (mousex m, mousey m)
mxy _ = (0,0)

mx :: !Device -> Int
mx (Mo m)= mousex m
mx _ = 0

my :: !Device -> Int
my (Mo m)= mousey m
my _ = 0


mousex :: !Dev -> Int
mousex m=
    code {
           ccall japi_getmousex "I-I"
     }

mousey :: !Dev -> Int
mousey m=
    code {
           ccall japi_getmousey "I-I"
     }

drawstr :: !Dev !Int !Int !String !JapiState -> (!Dev,!JapiState)
drawstr cv x y s js =
   code {
           ccall japi_drawstring "IIIS:I:I"
     }
          
circle :: !Dev !Int !Int !Int !JapiState-> (!Dev, !JapiState)
circle cv x y r js=
    code {
          ccall japi_drawcircle "IIII:I:I"
     }
    
rect :: !Dev !Int !Int !Int !Int !JapiState-> (!Dev, !JapiState)
rect cv x1 y1 x2 y2 js=
   code {
          ccall japi_drawrect "IIIII:I:I"
    }

fillrect :: !Dev !Int !Int !Int !Int !JapiState-> (!Dev, !JapiState)
fillrect cv x1 y1 x2 y2 js=
   code {
          ccall japi_fillrect "IIIII:I:I"
    }

cliparea :: !Dev !Int !Int !Int !Int !JapiState-> (!Dev, !JapiState)
cliparea cv x1 y1 x2 y2 js=
   code {
          ccall japi_cliprect "IIIII:I:I"
    }
    
jcliprect :: !Canvas !Int !Int !Int !Int !JapiState-> (!Canvas, !JapiState)
jcliprect cv x1 y1 x2 y2 js
   # (c, js)= cliparea (getCanvas cv) x1 y1 x2 y2 js
   = (updateCanvas cv c, js)

oval :: !Dev !Int !Int !Int !Int !JapiState-> (!Dev, !JapiState)
oval cv x1 y1 x2 y2 js=
   code {
          ccall japi_drawoval "IIIII:I:I"
    }

filloval :: !Dev !Int !Int !Int !Int !JapiState-> (!Dev, !JapiState)
filloval cv x1 y1 x2 y2 js=
   code {
          ccall japi_filloval "IIIII:I:I"
    }


drawroundrect :: !Dev !Int !Int !Int !Int !Int !Int !JapiState-> (!Dev, !JapiState)
drawroundrect cv x1 y1 w h st delta1 delta2=
   code {
          ccall japi_drawroundrect "IIIIIII:I:I"
    }

fillroundrect :: !Dev !Int !Int !Int !Int !Int !Int !JapiState-> (!Dev, !JapiState)
fillroundrect cv x1 y1 w h st delta1 delta2=
   code {
          ccall japi_fillroundrect "IIIIIII:I:I"
    }


drawarc :: !Dev !Int !Int !Int !Int !Int !Int !JapiState-> (!Dev, !JapiState)
drawarc cv x1 y1 w h st nd js=
   code {
          ccall japi_drawarc "IIIIIII:I:I"
    }

fillarc :: !Dev !Int !Int !Int !Int !Int !Int !JapiState-> (!Dev, !JapiState)
fillarc cv x1 y1 w h st nd js=
   code {
          ccall japi_fillarc "IIIIIII:I:I"
    }


jplaysoundfile :: !Int !String !JapiState -> (!Int, !*JapiState)
jplaysoundfile d nm js=
   code {
       ccall japi_playsoundfile "IS:I:I"
       }

class Sound f where
   jplaysound :: !f !String !JapiState -> (!f, !*JapiState)
   
instance Sound Device where
	jplaysound :: !Device !String !JapiState -> (!Device, !*JapiState)
	jplaysound dv nm js
    	# (d, js) = jplaysoundfile (getDevice dv) nm js
    	= (updateDevice dv d, js)

instance Sound TDev where
	jplaysound :: !TDev !String !JapiState -> (!TDev, !*JapiState)
	jplaysound dv nm js
    	# (d, js) = jplaysoundfile (getTDev dv) nm js
    	= (updateTDev dv d, js)

instance Sound Container where
	jplaysound :: !Container !String !JapiState -> (!Container, !*JapiState)
	jplaysound dv nm js
    	# (d, js) = jplaysoundfile (getContainer dv) nm js
    	= (updateContainer dv d, js)

instance Sound Framer where
	jplaysound :: !Framer !String !JapiState -> (!Framer, !*JapiState)
	jplaysound (Frm dv) nm js
    	# (d, js) = jplaysoundfile dv nm js
    	= (Frm d, js)
    	
    	

jsound :: !String -> Int
jsound s=
   code {
         ccall japi_sound "S-I"
    }
   
jplay :: !Int -> Int
jplay i=
   code {
         ccall japi_play "I-I"
    }

jmenubar :: !Int  !JapiState -> (!Dev,!*JapiState)
jmenubar fr  js=
   code {
         ccall japi_menubar "I:I:I"
   }

jmenu :: !Dev !String !JapiState -> (!Dev, !*JapiState)
jmenu mnu nm js=
   code {
      ccall japi_menu "IS:I:I"
      }
      
jmenuitem :: !Dev !String !JapiState -> (!Dev, !*JapiState)
jmenuitem mnu nm js=
   code {
      ccall japi_menuitem "IS:I:I"
      }

jdialog :: !Dev !String  !JapiState -> (!Dev,!*JapiState)
jdialog fr nm js=
   code {
         ccall japi_dialog "IS:I:I"
   }

pack :: !Dev  !JapiState -> (!Dev, !*JapiState)
pack dlg js=
   code {
      ccall japi_pack "I:I:I"
     }

class Packing f where
   jpack :: !f !JapiState -> (!f, !*JapiState)
   
instance Packing Container where
	jpack :: !Container !JapiState -> (!Container, !*JapiState)
	jpack dlg js
   		# (d, js) = pack (getContainer dlg) js
   		= (updateContainer dlg d, js)

instance Packing Framer where
	jpack :: !Framer !JapiState -> (!Framer, !*JapiState)
	jpack (Frm fr) js
   		# (d, js) = pack fr js
   		= (Frm d, js)
   		

jfileselect :: !Int !String !JapiState -> (!String,!*JapiState)
jfileselect fr msk js=
   code {
      ccall japi_file_select "IS:S:I"
    }

jfilesel :: !Framer !String !JapiState -> (!String,!*JapiState)
jfilesel (Frm fr) msk js
   # (nm, js) = jfileselect  fr  msk js
   = (nm, js)


//int japi_setfontsize( int arg0, int arg1)
jsetfontsize :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsetfontsize d sz js=
  code {
     ccall japi_setfontsize "II:I:I"
   }
   
//int japi_setcourierfont( int arg0)
jsetcourierfont :: !Dev !JapiState -> (!Dev, !*JapiState)
jsetcourierfont d js=
   code {
      ccall japi_setcourierfont "I:I:I"
     }

//int japi_settimesfont( int arg0)
jsettimesfont :: !Dev !JapiState -> (!Dev, !*JapiState)
jsettimesfont d js=
   code {
      ccall japi_settimesfont "I:I:I"
     }
     
//int japi_sethelvetiafont( int arg0)
jsethelvetiafont :: !Dev !JapiState -> (!Dev, !*JapiState)
jsethelvetiafont d js=
   code {
      ccall japi_sethelvetiafont "I:I:I"
     }

class SetFont f
where
   jsetfont :: !Font !f -> f

instance SetFont TDev
where
  jsetfont :: !Font !TDev  -> TDev
  jsetfont (Courier sz) d
     # (dev, js)= jsetcourierfont (getTDev d) 0
       (dev, js)=jsetfontsize dev sz 0
     = (updateTDev d dev)
  jsetfont (TimesNew sz) d
     # (dev, js)= jsettimesfont (getTDev d) 0
       (dev, js)=jsetfontsize dev sz 0
     = (updateTDev d dev)
  jsetfont (Helvetia sz) d
     # (dev, js)= jsethelvetiafont (getTDev d) 0
       (dev, js)=jsetfontsize dev sz 0
     = (updateTDev d dev)

instance SetFont Container
where
  jsetfont :: !Font !Container  -> Container
  jsetfont (Courier sz) d
     # (dev, js)= jsetcourierfont  (getContainer d) 0
       (dev, js)=jsetfontsize dev sz 0
     = (updateContainer d dev)
  jsetfont (TimesNew sz) d 
     # (dev, js)= jsettimesfont (getContainer d) 0
       (dev, js)=jsetfontsize dev sz 0
     = (updateContainer d dev)
  jsetfont (Helvetia sz) d 
     # (dev, js)= jsethelvetiafont (getContainer d) 0
       (dev, js)=jsetfontsize dev sz 0
     = (updateContainer d dev)
  jsetfont any c= c

instance SetFont Canvas
where
  jsetfont :: !Font !Canvas  -> Canvas
  jsetfont (Courier sz) d
     # (dev, js)= jsetcourierfont  (getCanvas d) 0
       (dev, js)=jsetfontsize dev sz 0
     = (updateCanvas d dev)
  jsetfont (TimesNew sz) d 
     # (dev, js)= jsettimesfont (getCanvas d) 0
       (dev, js)=jsetfontsize dev sz 0
     = (updateCanvas d dev)
  jsetfont (Helvetia sz) d 
     # (dev, js)= jsethelvetiafont (getCanvas d) 0
       (dev, js)=jsetfontsize dev sz 0
     = (updateCanvas d dev)
  jsetfont any c = c


instance SetFont Framer
where
  jsetfont :: !Font !Framer  -> Framer
  jsetfont (Courier sz) (Frm d) 
     # (dev, js)= jsetcourierfont  d 0
       (dev, js)=jsetfontsize dev sz 0
     = (Frm dev)
  jsetfont (TimesNew sz) (Frm d) 
     # (dev, js)= jsettimesfont d 0
       (dev, js)=jsetfontsize dev sz 0
     = (Frm dev)
  jsetfont (Helvetia sz) (Frm d) 
     # (dev, js)= jsethelvetiafont d 0
       (dev, js)=jsetfontsize dev sz 0
     = (Frm dev)
  jsetfont any c = c
  
instance SetFont LDev
where
  jsetfont :: !Font !LDev  -> LDev
  jsetfont (Courier sz) (Li d) 
     # (dev, js)= jsetcourierfont  d 0
       (dev, js)=jsetfontsize dev sz 0
     = (Li dev)
  jsetfont (TimesNew sz) (Li d) 
     # (dev, js)= jsettimesfont d 0
       (dev, js)=jsetfontsize dev sz 0
     = (Li dev)
  jsetfont (Helvetia sz) (Li d) 
     # (dev, js)= jsethelvetiafont d 0
       (dev, js)=jsetfontsize dev sz 0
     = (Li dev)
 
  
jrandom :: !Int !JapiState -> (!Int, !*JapiState)
jrandom seed js=
   code {
      ccall japi_random "I:I:I"
      }
         
jprinter_aux :: !Int !JapiState -> (!Dev, !*JapiState)
jprinter_aux fr js=
   code {
     ccall japi_printer "I:I:I"
   }

jprinter :: !Framer !JapiState -> (!Canvas, !*JapiState)
jprinter (Frm fr) js
   # (p, js)= jprinter_aux  fr js
   = (Pr p, js)


jprn :: !Dev  -> Dev
jprn p=
   code {
     ccall japi_print "I-I"
   }

class Print f where
    jprint :: !f  -> f
    
instance Print Canvas where
   jprint :: !Canvas  -> Canvas
   jprint (Pr p)
      # resp= jprn p 
      = Pr resp
   jprint cv= cv

instance Print RC where
   jprint :: !RC  -> RC
   jprint (Scale (Pr p) w h p1 p2)
      # resp= jprn p 
      = Scale (Pr resp) w h p1 p2
   jprint cv= cv


jdisp :: !Dev !JapiState -> (!Dev, !*JapiState)
jdisp p js=
   code {
      ccall japi_dispose "I:I:I"
     }

class Dispose f where
    jdispose :: !f !JapiState -> *JapiState
    
instance Dispose Canvas where
    jdispose :: !Canvas !JapiState -> *JapiState
    jdispose (Pr pr) js
      # (p, js) = jdisp pr js
      = js
    jdispose (Cv c) js
       # (p, js)= jdisp c js
       = js

instance Dispose RC where
    jdispose :: !RC !JapiState -> *JapiState
    jdispose (Scale (Pr pr) w h p q) js
      # (p, js) = jdisp pr js
      = js
    jdispose (Scale (Cv c) w h p q) js
       # (p, js)= jdisp c js
       = js
       
       

         
 

// New features

jsetp :: !Dev !Int !Int !JapiState -> (!Dev, !*JapiState)
jsetp f x y js=
   code {
      ccall japi_setpos "III:I:I"
      }
      
jsetpos :: !Device !Int !Int !JapiState -> (!Device, !*JapiState)
jsetpos fr x y js | nosize fr= (fr, js)
jsetpos fr x y js
   # (f, js) = jsetp (getDevice fr) x y js
   = (updateDevice fr f, js)
   
jmeter :: !Dev !String !JapiState -> (!Dev, !*JapiState)
jmeter f nm js=
   code {
      ccall japi_meter "IS:I:I"
    }


jsetminval :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsetminval f v js=
    code {
       ccall japi_setmin "II:I:I"
     }



jsetmaxval :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsetmaxval f v js=
    code {
       ccall japi_setmax "II:I:I"
     }
   

jsetmin :: !TDev !Int !JapiState -> (!TDev, !*JapiState)
jsetmin (Mt m) v js
      # (mtr, js) = jsetminval m v js
      = (Mt mtr, js)
jsetmin anyother v js= (anyother, js)

jsetmax :: !TDev !Int !JapiState -> (!TDev, !*JapiState)
jsetmax (Mt m) v js
      # (mtr, js) = jsetmaxval m v js
      = (Mt mtr, js)
jsetmax anyother v js= (anyother, js)
   

jsetdangerval :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsetdangerval f v js=
    code {
       ccall japi_setdanger "II:I:I"
     }

jsetdanger :: !TDev !Int !JapiState -> (!TDev, !*JapiState)
jsetdanger (Mt m) v js
   # (mtr, js) = jsetdangerval m v js
   = (Mt mtr, js)
   

jsetsz :: !Dev !Int !Int !JapiState -> (!Dev, !*JapiState)
jsetsz f w h js=
   code {
      ccall japi_setsize "III:I:I"
     }

jsetfixed :: !Dev !Int !Int !JapiState -> (!Dev, !*JapiState)
jsetfixed f w h js=
   code {
      ccall japi_setsize "III:I:I"
     }

nosize (Ac _)= True
nosize (Mo _)= True
nosize (Ke _)= True
nosize (Er _)= True
nosize anyother= False

jsetsize :: !Device !Int !Int !JapiState -> (!Device, !*JapiState)
jsetsize fr w h js | nosize fr= (fr, js)
jsetsize fr w h js
   # (f, js) = jsetsz (getDevice fr) w h js
   = (updateDevice fr f, js)

jpan :: !Dev !JapiState -> (!Dev, !*JapiState)
jpan fr js=
   code {
      ccall japi_panel "I:I:I"
      }
      
jpanel :: !Device !JapiState -> (!Dev, !*JapiState)
jpanel fr js
   # (p, js)= jpan (getDevice fr) js
   = (p, js)

jsethorizontallayout :: !Dev !JapiState -> (!Dev, !*JapiState)
jsethorizontallayout frm js=
   code {
      ccall japi_sethorizontallayout "I:I:I"
      }

jsetverticallayout :: !Dev !JapiState -> (!Dev, !*JapiState)
jsetverticallayout frm js=
   code {
      ccall japi_setverticallayout "I:I:I"
      }

jsethgap :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsethgap fr g js=
    code {
       ccall japi_sethgap "II:I:I"
       }
      

   
jsetvgap :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsetvgap fr g js=
    code {
       ccall japi_setvgap "II:I:I"
       }
      


class Layout f where
	hGap :: !f !Int !JapiState -> (!f, !*JapiState)
	vGap :: !f !Int !JapiState -> (!f, !*JapiState)
	jhorizontalLayout :: !f !JapiState -> (!f, !*JapiState)
	jverticalLayout :: !f !JapiState -> (!f, !*JapiState)
	
instance Layout Container where
	hGap :: !Container !Int !JapiState -> (!Container, !*JapiState)
  	hGap fr g js
   		# (f, js)= jsethgap (getContainer fr) g js
   		= (updateContainer fr f, js)
	vGap :: !Container !Int !JapiState -> (!Container, !*JapiState)
	vGap fr g js
   		# (f, js)= jsetvgap (getContainer fr) g js
   		= (updateContainer fr f, js)
	jhorizontalLayout :: !Container !JapiState -> (!Container, !*JapiState)
	jhorizontalLayout frm js
   		# (f, js) = jsethorizontallayout (getContainer frm) js
   		= (updateContainer frm f, js)
	jverticalLayout :: !Container !JapiState -> (!Container, !*JapiState)
	jverticalLayout frm js
   		# (f, js) = jsetverticallayout (getContainer frm) js
   		= (updateContainer frm f, js)
   		
instance Layout Framer where
	hGap :: !Framer !Int !JapiState -> (!Framer, !*JapiState)
  	hGap (Frm fr) g js
   		# (f, js)= jsethgap fr g js
   		= (Frm f, js)
	vGap :: !Framer !Int !JapiState -> (!Framer, !*JapiState)
	vGap (Frm fr) g js
   		# (f, js)= jsetvgap fr g js
   		= (Frm f, js)
	jhorizontalLayout :: !Framer !JapiState -> (!Framer, !*JapiState)
	jhorizontalLayout (Frm frm) js
   		# (f, js) = jsethorizontallayout frm js
   		= (Frm f, js)
	jverticalLayout :: !Framer !JapiState -> (!Framer, !*JapiState)
	jverticalLayout (Frm frm) js
   		# (f, js) = jsetverticallayout frm js
   		= (Frm f, js)
   		   
jsetfoc :: !Dev !JapiState -> (!Dev, !*JapiState)
jsetfoc dv js =
   code {
      ccall japi_setfocus "I:I:I"
    }
 
class Focus f where
	jsetfocus :: !f !JapiState -> (!f, !*JapiState)
	     
instance Focus Canvas where
	jsetfocus :: !Canvas !JapiState -> (!Canvas, !*JapiState)
	jsetfocus (Cv dv) js
   		# (d, js)= jsetfoc dv js
   		= (Cv d, js)
	jsetfocus dv js= (dv, js)
	
instance Focus TDev where
	jsetfocus :: !TDev !JapiState -> (!TDev, !*JapiState)
	jsetfocus dv js
   		# (d, js)= jsetfoc (getTDev dv) js
   		= (updateTDev dv d, js)

	

jsetic :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsetic dv i js=
   code {
      ccall japi_seticon "II:I:I"
    }
    
jseticon :: !Framer !Int !JapiState -> (!Framer, !*JapiState)
jseticon (Frm f) i js
     # (f, js) = jsetic f i js
     = (Frm f, js)

   
jlis :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jlis dv i js=
   code {
      ccall japi_list "II:I:I"
    }

jadditem :: !Dev !String !JapiState -> (!Dev, !*JapiState)
jadditem dv i js=
   code {
      ccall japi_additem "IS:I:I"
    }

addthem :: !Dev ![String] !JapiState -> (!Dev, !*JapiState)
addthem s [] js= (s, js)
addthem s [x:xs] js
   # (s, js)= jadditem s x js
   = addthem s xs js

class ListBox f where
	jnewLB :: !Pos !Int ![String] !f  !JapiState -> (!LDev, !*JapiState)
   

instance ListBox Framer where
	jnewLB :: !Pos !Int ![String] !Framer  !JapiState -> (!LDev, !*JapiState)
	jnewLB FLOW i xs (Frm f) js
   		# (s, js)= jlis f i js
     	  (s, js)= addthem s xs js
   		= (Li s, js)
    jnewLB (XY x y) i xs (Frm f) js
   		# (s, js)= jlis f i js
     	  (s, js)= addthem s xs js
     	  (xs, js)= jsetxy (Li s) x y js
   		= (xs, js)
	jnewLB (WH w h) i xs (Frm f) js
   		# (s, js)= jlis f i js
     	  (s, js)= addthem s xs js
     	  (xs, js)= jsetwh (Li s) w h js
   		= (xs, js)
	jnewLB (XYWH x y w h) i xs (Frm f) js
   		# (s, js)= jlis f i js
     	  (s, js)= addthem s xs js
     	  (xs, js)= jsetwh (Li s) w h js
     	  (xs, js)= jsetxy xs x y js
   		= (xs, js)

instance ListBox Container where
	jnewLB :: !Pos !Int ![String] !Container !JapiState -> (!LDev, !*JapiState)
	jnewLB FLOW i xs cn js
   		# (s, js)= jlis (getContainer cn) i js
     	  (s, js)= addthem s xs js
   		= (Li s, js)
   	jnewLB (XY x y) i xs cn js
   		# (s, js)= jlis (getContainer cn) i js
     	  (s, js)= addthem s xs js
     	  (xs, js)= jsetxy (Li s) x y js
   		= (xs, js)
	jnewLB (WH w h) i xs cn js
   		# (s, js)= jlis (getContainer cn) i js
     	  (s, js)= addthem s xs js
     	  (xs, js)= jsetwh (Li s) w h js
   		= (xs, js)
	jnewLB (XYWH x y w h) i xs cn js
   		# (s, js)= jlis (getContainer cn) i js
     	  (s, js)= addthem s xs js
     	  (xs, js)= jsetwh (Li s) w h js
     	  (xs, js)= jsetxy xs x y js
   		= (xs, js)


jgetsel :: !Dev -> Int
jgetsel s =
    code {
       ccall japi_getselect "I-I"
     }
     
jgetselect :: !LDev  -> (!Int, !LDev)
jgetselect (Li s)= (jgetsel s, Li s)

jsel :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsel dv i js=
   code {
      ccall japi_select "II:I:I"
    }

jselect :: !Int !LDev  -> LDev
jselect i (Li s)  
    # (s, js)= jsel s i 0
    = Li s


jdesel :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jdesel dv i js=
   code {
      ccall japi_deselect "II:I:I"
    }
    
jdeselect :: !Int !LDev   -> LDev
jdeselect i (Li s)
    # (s, js)= jdesel s i 0
    = (Li s)


jdrawpixel :: !Dev !Int !Int !JapiState -> (!Dev, !*JapiState)
jdrawpixel d x y js=
   code {
      ccall japi_drawpixel "III:I:I"
    }
    
jdrawpix ::  !(!Int, !Int) !Canvas -> Canvas
jdrawpix  (x, y) cv 
   # (c, js) = jdrawpixel (getCanvas cv) x y 0
   = (updateCanvas cv c)


jgetw :: !Dev !JapiState -> (!Int, !JapiState)
jgetw d js=
   code {
     ccall japi_getwidth "I:I:I"
    }

jgeth :: !Dev !JapiState -> (!Int, !JapiState)
jgeth d js=
   code {
     ccall japi_getheight "I:I:I"
    }

imagewidth :: !Int !JapiState -> (!Int, !JapiState)
imagewidth img js= jgetw img js 

imageheight :: !Int !JapiState -> (!Int, !JapiState)
imageheight img js= jgeth img js 

imagesize :: !Int !JapiState -> (!Int, !Int, !JapiState)
imagesize img js
   # (w, js)=  jgetw img js
   # (h, js)= jgeth img js
   = (w, h, js)
   

jgetwidth :: !Canvas  -> (!Int, !Canvas)
jgetwidth dv
   # (width, js)= jgetw (getCanvas dv) 0
   = (width, dv)

jgetheight :: !Canvas  -> (!Int, !Canvas)
jgetheight dv 
   # (height, js)= jgeth (getCanvas dv) 0
   = (height, dv)

      
 /* End */
 
jgetscreenht :: !Int !JapiState -> (!Int, !*JapiState)
jgetscreenht n js=
   code {
      ccall japi_getscreenheight "I:I:I"
    }
    
jgetscreenwd :: !Int !JapiState -> (!Int, !*JapiState)
jgetscreenwd n js=
   code {
      ccall japi_getscreenwidth "I:I:I"
    }

jnonresiz :: !Dev !JapiState -> (!Dev, !*JapiState)
jnonresiz n js=
   code {
      ccall japi_nonresizable  "I:I:I"
    }
    
jnonresizable :: !Framer !JapiState -> (!Framer, !*JapiState)
jnonresizable (Frm f) js
   # (f, js)= jnonresiz f js
   = (Frm f, js)
  

jnewFrame :: !Pos !String !JapiState -> (!Framer, !*JapiState)
jnewFrame (WH w h) nm js
    # (f, js)= jframe nm js
      (fr, js)= jsetwh (Frm f) w h js
    = jnonresizable fr js
jnewFrame (XY x y) nm js
   # (f, js)= jframe nm js
     (fr, js)= jsetxy (Frm f) x y js
   = (fr, js) 
jnewFrame (XYWH x y w h) nm js
  # (f, js)= jframe nm js
    (fr, js)= jsetxy (Frm f) x y js
    (fr, js)= jsetwh fr w h js
   = (fr, js) 
jnewFrame FLOW  nm js
  # (w, js)= jgetscreenwd 0 js
  # (h, js)= jgetscreenht 0 js
  # (f, js)=  jframe nm  js
  # (fr,js) = jsetwh (Frm f) w h js
  = jnonresizable fr js
  

jsetcurs :: !Dev !Int !JapiState -> (!Dev, !*JapiState)
jsetcurs d i js=
   code {
      ccall japi_setcursor "II:I:I"
    }


class SetCursor f where
   jsetcursor ::  !Int !f !JapiState-> (!f, !*JapiState)
      
instance SetCursor Framer where
   jsetcursor :: !Int !Framer !JapiState -> (!Framer, !*JapiState)
   jsetcursor i (Frm d) js
      # (d, js)= jsetcurs d i js
      = (Frm d, js)

instance SetCursor Container where
   jsetcursor :: !Int !Container !JapiState -> (!Container, !*JapiState)
   jsetcursor i dv js
      # (d, js)= jsetcurs (getContainer dv) i js
      = (updateContainer dv d, js)
      

// Extending Clean for Cartesian Coordinates 


instance + (a, b) | PlusMin a & PlusMin b
where
	(+) (x1, y1) (x2, y2) = (x1+x2, y1+y2)

instance - (a, b) | PlusMin a & PlusMin b
where
	(-) (x1, y1) (x2, y2) = (x1-x2, y1-y2)
	
	
instance + (Int,Int, Int)
where
	(+) :: !(Int, Int, Int) !(Int, Int, Int) -> (Int, Int, Int)
	(+) (r1, g1, b1) (r2, g2, b2) = (r1+r2, g1+g2, b1+b2)


(@) infix  9 :: !(a, a) Projection -> a
(@) (x, y) X = x
(@) (x, y) Y= y



class Draw f g where
   draw :: ![f] !g -> g	
   fill :: ![f] !g -> g
      
instance Draw Drawable Canvas where
  draw :: ![Drawable] !Canvas -> Canvas
  draw [] cv = cv
  draw [x:xs] cv= draw xs (jdraw x cv)
  fill :: ![Drawable] !Canvas -> Canvas
  fill [] cv = cv
  fill [x:xs] cv= fill xs (jfill x cv)

instance Draw CFig RC where
  draw :: ![CFig] !RC -> RC
  draw [] rcv = rcv
  draw [x:xs] rcv= draw xs (rdraw x rcv)
  fill :: ![CFig] !RC -> RC
  fill [] cv = cv
  fill [x:xs] cv= fill xs (rfill x cv)





apply :: !(Canvas -> Canvas) !(!Canvas, !JapiState) -> (!Canvas, !JapiState)
apply fn (cv, js)= (fn cv, js)


make_arrow :: !(!Int, !Int) !(!Int, !Int) !Dev -> Dev
make_arrow (ix1, iy1) (ix2, iy2) cv
  # (x1, y1)= (toReal ix1, toReal iy1)
  # (x2, y2)= (toReal ix2, toReal iy2)
  # (vx, vy)= (x2 - x1, y2-y1)
  # d= sqrt (vx*vx+vy*vy)
  # (s,c)=(vy/d, vx/d)
  # (sax, say)= (10.0, 6.0) 
  # (ax, ay)= (d-sax, say)
  # (bx, by)= (d-sax, ~say)
  # (xd1, yd1)= rotate (x1, y1) s c (ax, ay)
  # (xd2, yd2)= rotate (x1, y1) s c (bx, by)
  # (ixd1, iyd1)= (toInt xd1, toInt yd1)
  # (ixd2, iyd2)= (toInt xd2, toInt yd2)
  # (cv, _) = jdrawline cv ix1 iy1 ix2 iy2 0
  # (cv, _) = jdrawline cv ix2 iy2 ixd1 iyd1 0
  # (cv, _) = jdrawline cv ix2 iy2 ixd2 iyd2 0
  = cv

rotate (x0, y0) s c (vx, vy)=
  (x0+vx*c-vy*s, y0+vy*c + vx*s)
 
:: RC = Scale !Canvas !Real !Real !(!Real, !Real) !(Real, Real)
:: RCv :== (!Canvas, !(!Real, !Real), !(Real, Real))

mks :: !Canvas !(!Real, !Real) !(Real, Real) -> RC
mks cv p q
   # (w, cv) = jgetwidth cv
   # (h, cv) = jgetwidth cv
   = Scale cv (toReal w) (toReal h) p q

gCanvas :: !RC -> Canvas
gCanvas (Scale cv w h orig sz)= cv

rdraw :: !CFig !RC -> RC
rdraw fig (Scale cv w h orig sz)
   # (cv, orig, sz)= rdr fig w h (cv, orig, sz) 
   = Scale cv w h orig sz
   
rdr :: !CFig !Real !Real !RCv -> RCv
rdr (Line (x1, y1) (x2, y2)) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # p2= (toInt(xm*(x2+rx0)), toInt(ym*(y2+ry0)+qy)) 
   # cv= jdraw (Lin p1 p2) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (Arrow (x1, y1) (x2, y2)) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # p2= (toInt(xm*(x2+rx0)), toInt(ym*(y2+ry0)+qy)) 
   # cv= jdraw (Arr p1 p2) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr Axis w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # (x1, y1)= (~rx0, 0.0)
   # (x2, y2)= (rw-rx0-rw/20.0, 0.0) 
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # p2= (toInt(xm*(x2+rx0)), toInt(ym*(y2+ry0)+qy)) 
   # cv= jdraw (Arr p1 p2) cv
   # (x1, y1)= (0.0, ~ry0)
   # (x2, y2)= (0.0, rh-ry0-rh/20.0) 
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # p2= (toInt(xm*(x2+rx0)), toInt(ym*(y2+ry0)+qy)) 
   # cv= jdraw (Arr p1 p2) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (Circle (x1, y1) r) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # (a, b)= (toInt (xm*r), toInt (ym*r))
   # cv= jdraw (Ovl p1 a b) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (Oval (x1, y1) r1 r2) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # (a, b)= (toInt (xm*r1), toInt (ym*r2))
   # cv= jdraw (Ovl p1 a b) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (OvalArc (x1, y1) r1 r2 a1 a2) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # (a, b)= (toInt (xm*r1), toInt (ym*r2))
   # cv= jdraw (Arc p1 a b a1 a2) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (Rectangle (x1, y1) r1 r2) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # (a, b)= (toInt (xm*r1), toInt (ym*r2))
   # cv= jdraw (Rct p1 a b) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (Text (x1, y1) s) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # cv= jdraw (Txt p1 s) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (Pix (x1, y1)) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # cv= jdrawpix p1 cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (Image (x1, y1) i) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # cv= jdraw(Img p1 i) cv 
   = (cv, (rx0, ry0), (rw, rh))
rdr (Polygon xs) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # ps= [(toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy)) \\
              (x1, y1) <- xs]
   # cv= jdraw (Plg ps) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (Polyline xs) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # ps= [(toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy)) \\
              (x1, y1) <- xs]
   # cv= jdraw (Pll ps) cv
   = (cv, (rx0, ry0), (rw, rh))
rdr (Color c) w h (cv,  (rx0, ry0), (rw, rh))
    = (color c cv, (rx0, ry0), (rw, rh))
rdr (Background c) w h (cv,  (rx0, ry0), (rw, rh))
    = (bg_color c cv, (rx0, ry0), (rw, rh))
rdr (SetFnt f) w h (cv, (rx0, ry0), (rw, rh))
   = (jsetfont f cv,  (rx0, ry0), (rw, rh))  
rdr (SetXor b) w h (cv,  (rx0, ry0), (rw, rh))
    = (jsetxor b cv, (rx0, ry0), (rw, rh))

rfill :: !CFig !RC -> RC
rfill fig (Scale cv w h orig sz)
   # (cv, orig, sz)= rfi fig w h (cv, orig, sz) 
   = Scale cv w h orig sz

rfi :: !CFig !Real !Real !RCv -> RCv
rfi (Line (x1, y1) (x2, y2)) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # p2= (toInt(xm*(x2+rx0)), toInt(ym*(y2+ry0)+qy)) 
   # cv= jdraw (Lin p1 p2) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (Arrow (x1, y1) (x2, y2)) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # p2= (toInt(xm*(x2+rx0)), toInt(ym*(y2+ry0)+qy)) 
   # cv= jdraw (Arr p1 p2) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi Axis w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # (x1, y1)= (~rx0, 0.0)
   # (x2, y2)= (rw-rx0-rw/20.0, 0.0) 
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # p2= (toInt(xm*(x2+rx0)), toInt(ym*(y2+ry0)+qy)) 
   # cv= jdraw (Arr p1 p2) cv
   # (x1, y1)= (0.0, ~ry0)
   # (x2, y2)= (0.0, rh-ry0-rh/20.0) 
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # p2= (toInt(xm*(x2+rx0)), toInt(ym*(y2+ry0)+qy)) 
   # cv= jdraw (Arr p1 p2) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (Circle (x1, y1) r) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # (a, b)= (toInt (xm*r), toInt (ym*r))
   # cv= jfill (Ovl p1 a b) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (Oval (x1, y1) r1 r2) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # (a, b)= (toInt (xm*r1), toInt (ym*r2))
   # cv= jfill (Ovl p1 a b) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (OvalArc (x1, y1) r1 r2 a1 a2) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # (a, b)= (toInt (xm*r1), toInt (ym*r2))
   # cv= jfill (Arc p1 a b a1 a2) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (Rectangle (x1, y1) r1 r2) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # (a, b)= (toInt (xm*r1), toInt (ym*r2))
   # cv= jfill (Rct p1 a b) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (Text (x1, y1) s) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # cv= jdraw (Txt p1 s) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (Pix (x1, y1)) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # cv= jdrawpix p1 cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (Image (x1, y1) i) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # p1= (toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy))
   # cv= jdraw(Img p1 i) cv 
   = (cv, (rx0, ry0), (rw, rh))
rfi (Polygon xs) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # ps= [(toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy)) \\
              (x1, y1) <- xs]
   # cv= jfill (Plg ps) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (Polyline xs) w h (cv,  (rx0, ry0), (rw, rh))
   # xm= w/rw
   # ym= ~h/rh
   # qy= h
   # ps= [(toInt (xm*(x1+rx0)), toInt (ym*(y1+ry0) + qy)) \\
              (x1, y1) <- xs]
   # cv= jdraw (Pll ps) cv
   = (cv, (rx0, ry0), (rw, rh))
rfi (Color c) w h (cv,  (rx0, ry0), (rw, rh))
    = (color c cv, (rx0, ry0), (rw, rh))
rfi (Background c) w h (cv,  (rx0, ry0), (rw, rh))
    = (bg_color c cv, (rx0, ry0), (rw, rh))
rfi (SetXor b) w h (cv,  (rx0, ry0), (rw, rh))
    = (jsetxor b cv, (rx0, ry0), (rw, rh))



rmxy :: !Device !RC -> (!(!Real, !Real), !RC)
rmxy mouse (Scale cv w h  (rx0, ry0) (rw, rh))
   # (xc, yc) = mxy mouse
   # xm= rw/w
   # ym= ~rh/h
   # (x, y)= (xm*(toReal xc)-rx0, ym*(toReal yc) +rh-ry0)
   = ((x, y), Scale cv w h  (rx0, ry0) (rw, rh))

